home *** CD-ROM | disk | FTP | other *** search
/ Magnum One / Magnum One (Mid-American Digital) (Disc Manufacturing).iso / d18 / jockdem4.arc / LISTDEM3.PAS < prev    next >
Pascal/Delphi Source File  |  1991-04-28  |  2KB  |  87 lines

  1. Program ListTTT5_Demo_3;
  2.  
  3.   This an example is extension of the programs listdem1.pas and
  4.   listdem2.pas. In this third example, a user hook has been added.
  5. }
  6.  
  7. Uses CRT, DOS, FastTTT5, WinTTT5, ListTTT5;
  8.  
  9. const
  10.     ListWidth = 60;
  11. type
  12.     StrList  = string[ListWidth];
  13.  
  14. var
  15.     MyList   : array[1..30] of StrList;
  16.  
  17.  Procedure Fill_MyList;
  18.  {}
  19.  begin
  20.      MyList[1] := 'Erica';
  21.      MyList[2] := 'Alison';
  22.      MyList[3] := 'Barbara';
  23.      MyList[4] := 'Sarah';
  24.      MyList[5] := 'Katy';
  25.      MyList[6] := 'Janice';
  26.      MyList[7] := 'Susan';
  27.      MyList[8] := 'Serita';
  28.      MyList[9] := 'Anne';
  29.      MyList[10] := 'Michelle';
  30.      MyList[11] := 'Theresa';
  31.      MyList[12] := 'Shirley';
  32.      MyList[13] := 'Sue';
  33.      MyList[14] := 'Marianne';
  34.      MyList[15] := 'Wilma';
  35.      MyList[16] := 'Beatrice';
  36.      MyList[17] := 'Regina';
  37.      MyList[18] := 'Sudofed';
  38.      MyList[19] := 'Trojan';
  39.      MyList[20] := 'Whip';
  40.  end; {of proc Fill_MyList}
  41.  
  42.  
  43.  
  44.  {$F+}
  45.  Procedure Commentary(var Ch:char; HiPick:byte);
  46.  {}
  47.  begin
  48.      If Ch = #188 then  {F2}
  49.      Case HiPick of
  50.      1 : TempMessageBoxCh(2,10,white,blue,1,'Good fun but married',Ch);
  51.      2 : TempMessageBoxCh(2,10,white,blue,1,'Good looking but boring',Ch);
  52.      3 : TempMessageBoxCh(2,10,white,blue,1,'Nice but too shy',Ch);
  53.      4 : TempMessageBoxCh(2,10,white,blue,1,'Gross but rude',Ch);
  54.      5 : TempMessageBoxCh(2,10,white,blue,1,' 10 ',Ch);
  55.      6 : TempMessageBoxCh(2,10,white,blue,1,'Drinks like a horse (!!) ',Ch);
  56.      18: TempMessageBoxCh(2,10,white,blue,1,'For the morning after',Ch);
  57.      19: TempMessageBoxCh(2,10,white,blue,1,'Never leave home without ''em',Ch);
  58.      20: TempMessageBoxCh(2,10,white,blue,1,'You never know',Ch);
  59.      else
  60.          TempMessageBoxCh(2,10,white,blue,1,'No specific knowledge (yet!)',Ch);
  61.      end;
  62.  end; {of proc Commentary}
  63.  {$F-}
  64.  
  65. begin
  66.     Fill_MyList;
  67.     ClrScr;
  68.     with LTTT do
  69.     begin
  70.         Lines := 15;
  71.         Y := 2;
  72.         LeftChar := chr(026);
  73.         RightChar := ' ';
  74.         AllowToggle := false;
  75.     end;
  76.     L_UserHook := @Commentary;
  77.     WriteCenter(25,lightred,black,'Press F2 for a commentary');
  78.     Show_List(MyList,ListWidth,20);
  79.     ClearText(1,1,80,25,white,black);
  80.     WriteAT(1,1,white,black,'Run DemoTTT.exe for the main demo program');
  81.     WriteAT(1,2,white,black,'TechnoJock''s Turbo Toolkit v5.0');
  82.     GotoXY(1,5);
  83. end.
  84.  
  85.  
  86.